perm filename S3X.F4[M11,LCS] blob sn#418034 filedate 1979-02-10 generic text, type T, neo UTF8
00100	C ********** S3X.F4 ******* SEE RUN.CMD, SCORE.CMD   -- 
00200	C   AND, IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
00300	C	SUBROUTINE SUBR
00400	C	COMMON /P/P(1) /PL/IPL(1) /INS/ RINST(27),BG(60)
00500	C	COMMON INUM,IPAR /KNT/KNT(27),BT,IREST,DF /DUR/DUR(27)
00600	C   INUM=INST#  IPAR=PARAM#  
00700	C   BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
00800	C   IF IREST IS <0, THAT NOTE WILL BE A REST.  
00900	C   RINST=INST. NAME,  BG=INSTS' BEGIN TIMES.
01000	C   NOTE #S IN SUBROUTINE: (1-108)  C4=49  FS4=55  B4=60  C5=61  ETC.
01100	C   F0=200  F99=299 (LIMIT IS F0-F99!)  'R'(REST)=199
01200	
01300		SUBROUTINE RUNIT
01400		INTEGER PL,PL4,COPYL
01500	C11	DOUBLE PRECISION IF0,IF00,IVX,IV
01600		COMMON /PCIP/ PCH(27,33) /IPT/IPT(27,32) /JPREC/JPREC
01700	C 2ND NUM IN IPT=NUMP+2. (NUMPY)
01800	C PL SHOULD HAVE ABOUT NUMP+17
01900		COMMON/P/P(30) /PL/PL(47) /NUMP/NUMP /NDEV/NDEV
02000		1 /COPY/COPY(30)  /COPYL/COPYL(30)
02100	CKL	COMMON/P/P(1) /PL/PL(1) /COPY/NUMP,COPY(1)/COPYL/COPYL(1)
02200	
02300		COMMON /Q/ BNW(200),NWZ /INS/RINST(27),BG(60) /TYP/JOUT,LN
02400		1  /ROFF/ROFF(27),RDEV(27),P1(27)
02500		1 /VV/LIMIT,V(1) /A/NP(27),XT(27),FRM(80),INVIS(27)
02600	C  JPT MUST BE .LE.27*NUMPY !!
02700		DIMENSION IV(1),IT(30),JPT(837),NCNT(27,32)
02800		1,COFF1(27),COFF2(27),RREST(27),RNP(27),ISC(12),IOC(9)
02900	C   WITH VX AT 70 AND FRM AT 80 OK FOR ONLY 
03000	C   40 LIT CHARS + 30 PARAMS PER INST.
03100	C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
03200		COMMON J,L /DUR/DUR(27) /KNT/KNT(27),BT,IREST,DF
03300		1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG
03400		1 ,VX(70),RAMP,K,KN,M,ML,CODE
03500		COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
03600		1 Y,Z,FNAME,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,NL,RC,W,
03700		1 ZZ,CHN,YY 
03800		1 /D/TF,AMPFAC,OP1,DURX,IXIN,FLNM
03900		1 /C/T,NWZZ,IT3,T6,NW,TDUR,A,T2,T4,BY,
04000		1 KODE,NPAR,LP,TBG,AC,NPA,IBX,IDF,PM,NM,PAR,PX2,T1,RD,
04100		1 VIJ2
04200	C  /C/=26
04300		EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
04400		1 (VX1,VX(1)),(PL4,PL(4)),(IPT,JPT),(IVX,RVX)
04500		1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
04600		1 ,(VX5,VX(5)),(V,IV)
04700	CC    DATA SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
04800	CC	1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
04900	CC	1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
05000	CC	1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
05100	CC	1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
05200	CC	1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
05300	CC	1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
05400	CC	1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
05500	CC	1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
05600	CC	1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
05700	CC	1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/,
05710		DATA MDEV/1/
05720	C  ********* MDEV IS A DSK OUTPUT DEVICE NUMBER.
05800		DATA B1X/'1X'/,FRM1/' (1XA'/,FRM2/'4,  '/,COMMA/4H',',/,
05900		1 BA4/'1XA5'/,BA1/'A1, '/,IF0/'   F0'/,IF10/'  F00'/,
06000		1 BDOL/'$)'/,B2A/' 2F9.'/, NPRLN/8/,
06100		1 B2B/'3,  '/,B9/'F9.1'/,B8/'F8.3'/,BPRN/')   '/,BLA/' '/
06200		1, BCOM/',   '/,RNDOFF/1000.0/,IBLA/' '/,PLAY/'PLAY'/,ISEMI/';'/
06300	C********************CHANGE BA4 TO '1XA4' ************************
06400	C******** ALSO FRM1 TO '(1XA'   ---- ETC.!!!!!!!
06450	C  NPRLN IS NUMBER OF PARAMS TO BE PRINTED PER LINE.
06500		DATA ISC/'  C  ',' CS  ','  D  ',' DS  ','  E  ','  F  ',
06600		1 ' FS  ','  G  ',' GS  ','  A  ',' AS  ','  B  '/,
06700		1 IOC/3872, 3888,3880,3876, 0, 2596,2600,2604, 2592/
06800	C FUNNY NUMS IN IOC = /0, /8, /4, /2, IBLA, *2, *4, *8, *0   (0=16 FOR MULT OR DIV.)
06900	C  THESE APPEAR AS LAST 3 CHARS. WHEN ADDED TO ELEMENTS OF ISC ARRAY.
07000		EQUIVALENCE (FRM1,FRM(1)),(FRM2,FRM(2)),(FRM3,FRM(3)),
07100		1 (FRM4,FRM(4))
07200	
07300	C*****	XXXX MUS10 NOW FIXED XXXXX   IF(ISAM.GE.0)RNDOFF=100.0
07400	C USE DIFF. ROUND-OFF FOR MUS10 (100) (SAMSWITCH ≥0)
07500		IF(JPREC.GE.0)GO TO 9350
07600	C NOW FOUND 'PRECEDE' MATERIAL TO TYPE OR WRITE ON DSK.
07700	9351	READ(21,END=9350)K,(XT(J),J=1,K)
07800		IF(MZ)WRITE(JOUT,9352)(XT(J),J=1,K)
07900		IF(MX)WRITE(MDEV,9353)(XT(J),J=1,K)
08000		GO TO 9351
08100	9352     FORMAT(1X15A5)
08200	9353     FORMAT(15A5)
08300	9350	ITOT=1
08400		NUMPX=NUMP+1
08500		NUMPY=NUMP+2
08600		PR=0
08700		DO 9337 K=1,27
08800		KNT(K)=0
08900		RDEV(K)=0
09000		IPT(K,1)=0
09100		COFF1(K)=0
09200	9337	RREST(K)=0
09300	C  ZEROS NAME CHANGE, CUTOFF AND RAND REST STORAGE
09400	2337	T=0
09500		DO 1107 K=1,NUMP
09600	1107	PL(K)=1
09700	C  2/74--WAS AT 17300/1   SETS DEFAULT OUTPUT MODE TO 1.
09800		WRITE(JOUT,902)
09900	C   WRITES A BLANK LINE  (IF 'SOS' WAS HERE)
10000		NWZZ=0
10100		RAMP=0
10200		IT3=0
10300		K=1
10400	      IX=0  
10500		BG(NINS+1)=19999.
10600	4337	IF(V(I-1).EQ.-9900.-BY)I=I-1
10700		V(I)=-19899.
10800	      PP1=0
10900	      T6=10000.   
11000	      DO 2118 K=1,NINS  
11100		ROFF(K)=0
11200	C********* FEB 17,71
11300		M=NP(K)
11400	      IT(K)=0 
11500		IPT(K,NUMPX)=0
11600		NCNT(K,NUMPX)=1
11700		DO 2118 L=1,M
11800		NCNT(K,L)=1
11900	2118	IPT(K,L)=0
12000		DO 5013 K=1,IXIN
12100	5013	X=RAN(X)
12200	C  NOW USES EXTENSION .DAT WHEN WRITING ON DSK (DEV. 1 ONLY!)
12300	      NW=1    
12400		NWX=0
12500	      TDUR=0
12600		A=0
12700	      T2=1. 
12800	      T4=1. 
12900	      T5=0  
13000		J=1
13100		IF(MX.NE.5)GO TO 1002
13200	CKL	IF(MX.NE.5)GO TO 40021
13300		K=4
13400	10023	N=AMOD(V(K),100.0)/-11.
13500	C  AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
13600		IF(N.EQ.2)GO TO 77
13700		IF(N.EQ.3)GO TO 77
13800		IF(N.NE.4)GO TO 10021
13900	C TYPES OUT LIST OF ITEMS IN CODE NUMS -2n, -3n, -4n.
14000	77	IF(V(K-2).LT.10000.)GO TO 10021
14100	C FINDS A PARAM. NUM.
14200		J=V(K+1)
14300		KA=K+ABS(V(K-1))
14400	C FOR UPDATE OF POINTER.
14500		IF(J.EQ.1)GO TO 10024
14600	177	N=V(K-2)
14700		L=N/10000
14800		M=N-L*10000
14900		IF(V(KA-2).EQ.-10000.)J=J-1
15000	C DON'T INCLUDE 'FINE' AS AN ITEM.
15100		WRITE(NDEV,10022)RINST(L),M,J
15200	10024	K=KA
15300	10021	K=K+1
15400		IF(K.LT.I)GO TO 10023
15500	CKL40021	IF(MZ.NE.-6)GO TO 1002
15600	CKL	N=1
15700	CKL40022	K=N+1
15800	CKL	IF(N.GT.I)CALL EXIT
15900	CKL	X=V(N)
16000	CKL	IF(X.EQ.-199.)GO TO 40024
16100	CKL	IF(X.EQ.-99.)GO TO 40024
16200	CKL	IF(X.GE.0)GO TO 40023
16300	CKL	TYPE 4002,X
16400	CKL	N=N+1
16500	CKL	GO TO 40022
16600	CKL40024	J=N+1
16700	CKL	GO TO 40025
16800	C  FOR 'SECTIONS'
16900	CKL40023	J=ABS(V(K))+K-1
17000	CKL40025	TYPE 4002,(V(K),K=N,J)
17100	CKL	N=J+1
17200	CKL	GO TO 40022
17300	10022	FORMAT(1XA4,' P',I2,'  HAS ',I3,' ITEMS.')
17400	CKL4002  FORMAT(10F12.3)
17500	1002	IF(IDALL)GO TO 600
17600		X=DUR(IDALL)
17700		DO 2002 K=1,NINS
17800	2002	IF(DUR(K))DUR(K)=X
17900	
     

00100	C ***** SORTER *************************  
00200	C  *******  OUTPUT LOOP FROM HERE ON  ********
00300	600      IL=0     
00400	C********** BELOW IS FOR 'SECTIONS'
00500		KODE=0
00600		NWX=NWX+1
00700	      Y=BNW(NW)   
00800	723      IL=IL+1  
00900	3723      Z=V(IL)     
01000	      IF(Z.EQ.-19899.)GO TO 732
01100	      IF(Z.NE.-9900.-Y)GO TO 723     
01200	C********** BELOW IS FOR 'SECTIONS'
01300		IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
01400	2723      IL=IL+1   
01500	729	K=IL+2
01600		MOT=V(IL+1)
01700		RD=V(K)
01800		IF(RD.EQ.-67.)GO TO 3726
01900		RB=V(IL)
02000	C************ DOWN TO 4150 IS FOR 'SECTIONS'
02100		IF(RB.NE.-99.)GO TO 4150
02200		KODE=IV(K-1)
02300	2160	IF(KODE.EQ.0)GO TO 723
02400	  	IF(MZ)WRITE(JOUT,9150),KODE
02500		KL=Y/10000.
02600		RB=Y+KL*10000.
02700	
02800		DO 5150 KL=1,I
02900		IF(V(KL).NE.-199.)GO TO 5150
03000		IF(IV(KL+1).NE.KODE)GO TO 5150
03100		IV(K-1)=0
03200	C  WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
03300		RD=V(KL+2)+9900.
03400		DO 6150 L=KL+2,I
03500		M=V(L)/(-9900.)
03600		IF(M.NE.1)GO TO 6150
03700		RA=RB+RD-V(L)-9900.
03800		V(L)=-9900.-RA
03900	C  UPDATES BG TIMES INSIDE SECTION.
04000		CALL BGSORT(RA)
04100	C  UPDATES LIST OF CHANGE TIMES.
04200	6150	IF(V(L).EQ.-299.)GO TO 160
04300	5150	CONTINUE
04400	
04500	160	IL=1
04600		GO TO 3723
04700	C***********  ABOVE IS FOR 'SECTION' REPEATS
04800	4150	LK=RB/10000.+.2
04900		IF(LK.GE.98)GO TO 7700
05000		LP=RB-LK*10000
05100	C   LK=INST #   LP=PARAM #
05200		LN=IPT(LK,LP)
05300		IPT(LK,LP)=IL+2
05400		IF(RD.EQ.-66.)GO TO 726
05500	CCCCCCC 'K' IS USED AS POINTER AT 6700-DON'T WIPE IT OUT!	K=RD/-10.
05600	CCCCCCC	IF(K.EQ.5)GO TO 1726
05700		IF(IFIX(RD/-10.).EQ.5)GO TO 1726
05800	C -59=MOVX, -55=MOV.
05900		IF(RD.EQ.-23)GO TO 6700
06000	
06100	2727	ML=IPT(LK,LP)
06200		IF(MOT.GT.0)GO TO 3727
06300	C  USE NEG WDCNT FOR 'ALL'
06400		DO 4727 KL=LK+1,NINS
06500		IF(NP(KL).GE.LP)GO TO 277
06600		IF(LP.LT.NUMPX)NP(KL)=LP
06700	277	IPT(KL,LP)=-(LK+(LP-1)*KZY)
06800		NCNT(KL,LP)=10000
06900	4727	IF(DUR(KL))DUR(KL)=10000.
07000	C  ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
07100	C  AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
07200		GO TO 727
07300	C 'MOVE' WITH 'ALL' KEEPS ORIGINAL BG TIME DATA REGARDLESS OF LATER BG TIMES.
07400	3727	IF(LN.LE.0)GO TO 727
07500	    	IF(V(IL).NE.V(LN-1))GO TO 727
07600		DO 1727 L=1,NINS
07700		DO 1727 KL=1,NP(L)
07800		IF(LN.NE.IPT(L,KL))GO TO 1727
07900		NCNT(L,KL)=10000
08000		IPT(L,KL)=ML
08100	C RESETS POINTERS FOR DUPL AND REP INSTS.
08200	1727	CONTINUE
08300	
08400	727	NCNT(LK,LP)=10000
08500	2150	IF(MOT)MOT=-MOT
08600		IL=IL+MOT+1
08700	3150	IF(V(IL))GO TO 3723
08800		GO TO 729
08900	726	RB=V(IL+3)
09000		K=RB/10000.
09100		L=RB-K*10000
09200		IPT(LK,LP)=-(K+(L-1)*KZY)
09300		GO TO 2727
09400	3726	LK=V(IL)
09500		M=V(K+1)
09600		KL=NP(M)
09700		DO 4726 L=1,KL
09800		IPT(LK,L)=IPT(M,L)
09900		IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
10000	4726	CONTINUE
10100	C NUMPX =31 (NUMP+1) NEXT DUPLS. RAN. RESTS.
10200		IPT(LK,NUMPX)=IPT(M,NUMPX)
10300		K=0
10400		GO TO 2150
10500	C   ABOVE IS FOR DUPLICATION ROUTINE   NEXT ADJUSTS TIMES FOR 'RTAP'
10600	6700	KL=IL+V(IL+1)+1.3
10700		RC=V(K-2)
10800	1770	IF(V(KL))GO TO 700
10900	2700	KL=KL+V(KL+1)+1.3
11000		GO TO 1770
11100	700	KL=KL+1
11200		IF(Z.NE.V(KL-1))GO TO 2700
11300		IF(V(KL).NE.RC)GO TO 2700
11400		KL=KL+3
11500		KN=IL+3
11600		LN=V(KN)+.3
11700		DO 3700 L=1,LN,2
11800		RA=V(L+KN)
11900		KA=V(L+KN+1)+.3
12000		RB=0
12100		DO 4700 LP=1,KA
12200	4700	RB=RB+V(KL+LP)
12300		DO 5700 LP=1,KA
12400	5700	V(KL+LP)=V(KL+LP)/RB*RA
12500		V(KL+KA)=V(KL+KA)+.00030
12600	C  NEEDS ERROR TRAP HERE FOR SITUATION WHEN THERE AREN'T ENOUGH TAPS.
12700	3700	KL=KL+KA
12800		GO TO 2150
12900	
13000	C  BELOW FOR 'TEMPO' SETUP
13100	7700	T2=V(IL+4)
13200		T1=V(IL+3)
13300		TBG=Y
13400		TDUR=V(IL+2)
13500		CALL SQYY(AC,T1,T2,TDUR)
13600	8700	IF(TDUR.EQ.0)TDUR=10000.
13700		T5=1.
13800		T6=TBG+TDUR
13900		IT3=1.
14000		IF(LK.EQ.98)IT3=IL+2
14100		T4=1.
14200		GO TO 2150
14300	C*************** ANY WDCNTS DOWN FROM HERE. *********
14400	C   NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
14500	1726	IF(V(IL-1).GT.-19000.)GO TO 2727
14600		RA=BT
14700		K=IL-1
14800	2726	RZ=V(K)
14900		V(K)=-9900.-RA
15000		ISUB=-1
15100		L=K+5
15200		K=K+V(K+2)+2
15300		IF(V(K).GT.-19000.)GO TO 2727
15400		IF(V(K+1).NE.V(IL))GO TO 2727
15500		
15600		IF(V(K).NE.RZ-V(L-1))GO TO 2727
15700		RA=RA+V(L-1)
15800		CALL BGSORT(RA)
15900		GO TO 2726
16000	C  CONVERTS BG TIME OF NOTE NUM TO REAL TIME.  DOESN'T WORK WITH -66!
16100	C   NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
16200	732	DO 2606 K=NW,NWZ
16300	2606	BNW(K)=BNW(K+1)
16400		NWZ=NWZ-1
16500		IF(NWZ.EQ.0)GO TO 2111
16600		IF(NWZZ.EQ.1)GO TO 5111
16700		NWZZ=1
16800		IF(NWZ.EQ.1)GO TO 1111
16900		DO 3111 K=1,NWZ
17000		IF(BNW(K).LT.1000.)GO TO 3111
17100		X=BNW(NWZZ)
17200		BNW(NWZZ)=BNW(K)
17300		BNW(K)=X
17400		NWZZ=NWZZ+1
17500	3111	CONTINUE
17600	5111	IF(NWZZ.EQ.NWZ)GO TO 1111
17700		L=NWZZ+1
17800		X=BNW(NWZZ)
17900		DO 4111 K=L,NWZ
18000		IF(BNW(K).GT.X)GO TO 4111
18100		RA=BNW(K)
18200		BNW(K)=X
18300		X=RA
18400	4111	CONTINUE
18500		BNW(NWZZ)=X
18600		GO TO 1111
18700	111      FORMAT(1XA4,'.DAT',12X,'EDIT FILE NAME=',A4,8X,
18800		1'STORAGE=',I5,'/',I5,/' TEMPO FACTOR=',F6.2/)
18900	1023	FORMAT(/'  < ',A4,'.DAT  --  RANDOM NUMBER=',I6/1X2A4)
19000	C********** BELOW IS FOR 'SECTIONS'
19100	9150	FORMAT(/3X'******* SECTION ',A1)
19200	2111	NWZ=-1
19300	C  ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
19400	1111	IF(MZ.EQ.0)GO TO 2601
19500	      IF(NWX.NE.1)GO TO 1486
19600	      WRITE(JOUT,111)FNAME,FLNM,I,LIMIT,TF
19700	C********** BELOW IS FOR 'SECTIONS'
19800	1486	IF(KODE.NE.0)WRITE(JOUT,9150),KODE
19900		K=NWX-1
20000	        IF(NWX.LE.1)GO TO 377
20100		IF(IT(J).NE.-3)WRITE(JOUT,3154),K,Y  
20200	377	IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,IBX,RINST(J) 
20300	
20400	2601  DO 602 K=1,NINS   
20500	48	RIN=RINST(K)
20600	  	IF(NCNT(K,NUMPX).EQ.10000)GO TO 477
20700		IF(NWX.GT.1)GO TO 602
20800	477	NCNT(K,NUMPX)=1
20900		IJ=IPT(K,NUMPX)
21000		X=0
21100		IF(IJ.NE.0)X=ALL(JPT,IPT(K,NUMPX))
21200	C CHECK FOR "ALL" WITH RAND. DEV.  
21300	CC	IF(IJ.NE.0)X=V(IJ+2)
21400	      WRITE(JOUT,5396),K,RIN,X
21500		X=DUR(K)
21600	      IF(X.GT.10000.)GO TO 83 
21700	      WRITE(JOUT,8396),X     
21800		GO TO 602
21900	5396      FORMAT(I3,') 'A4,'  RANDOM TF =',F4.2,7X,'DURATION =',$) 
22000	7396      FORMAT('+',F5.0,' NOTES')    
22100	8396      FORMAT('+',F7.2,'"')   
22200	83      X=X-10000.
22300	      WRITE(JOUT,7396),X    
22400	602	CONTINUE
22500		IF(MZ.EQ.0)GO TO 1601
22600	715	IF(IT3.NE.1.)GO TO 1602
22700		RA=T1*60.
22800		RB=T2*60.
22900	      WRITE(JOUT,6154),RA,RB,TDUR  
23000	      IT3=0  
23100	1602	IF(NWX.EQ.1)GO TO 315
23200	      IF(IT(J).EQ.-3)GO TO 1108
23300		IT(J)=IT(J)/10
23400		GO TO 1108
23500	6154      FORMAT(' TMP=',F7.3,' TO',F8.3,
23600		1' DURING',F6.2,' SECS. BASIC TIME.'/)
23700	5154      FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',I4,1XA4,' >>'/)
23800	902      FORMAT(1XA4/)  
23900	3154      FORMAT(/' <<   BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
24000	4154      FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)  
24100	315	IF(OP1.NE.0)WRITE(JOUT,4154),OP1 
24200	1601  IF(NWX.GT.1) GO TO 1108
24300		IF(TF.GT.10.)TF=TF/60.
24400		TF=RNDOFF/TF
24500	C RNDOFF IS ROUND OFF NUMBER. (100 OR 1000)
24600	CROFF	 100 HERE FOR NEW DAC!?#@&βX 1/76  TF=1000./TF
24700		DO 6015 K=3,NUMP
24800		COPYL(K)=-9900
24900	6015	COPY(K)=-9900.
25000	C  INITS PARAM REPRESSION FEATURE.
25100	9926      DO 5015 K=1,NINS    
25200		IQ(K)=BG(K)*10000.
25300	      BG(K)=0
25400		RNP(K)=0
25500	      P1(K)=0     
25600		IF(DUR(K).LE.10000.)DUR(K)=DUR(K)-.0001
25700	C******* FEB. 16,71   FOR ROUND-OFF NONSENSE
25800	5015      KNT(K)=0
25900	CKL	IF(MZ)WRITE(JOUT,1023),FNAME,IXIN,PLAY
26000	CKL	IF(MX)WRITE(1,1023)FNAME,IXIN,PLAY
26100	   	IF(MZ)WRITE(JOUT,1023),FNAME,IXIN,PLAY,ISEMI
26200		IF(MX)WRITE(MDEV,1023)FNAME,IXIN,PLAY,ISEMI
26300	      BW=0 
26400		GO TO 500
26500	
     

00100	1108	M=0 
00200		JC=0  
00300		CCHD=0
00400	C  NWZZ IS SET AT 3111 IN SORTR.  CCHD IS FOR CHORD FEATURE.
00500	CKL	IF(NWZ)GO TO 1740
00600		IF(NWZ)GO TO 31
00700		DO 740 K=1,NWZZ
00800		X=BNW(K)    
00900		IF(X-.0001.GT.BT)GO TO 2740
01000		IF(X.LE.BW)GO TO 2740
01100		IF(BW)GO TO 2740
01200		IT(J)=IT(J)*10
01300		NW=K  
01400		GO TO 600   
01500	2740	IF(X.LT.1000.)GO TO 740
01600		IF(X-J*10000.NE.KNT(J)+1.)GO TO 740
01700		X=BT+PR     
01800		NW=K  
01900		IBX=KNT(J)+1
02000		IT(J)=-3    
02100		GO TO 600   
02200	740	CONTINUE 
02300		IT(J)=0     
02400	31      KL=1
02500	2031      KNT(J)=KNT(J)+1   
02600	      ICT=KNT(J)  
02700	C   INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
02800	      NPA=NP(J)   
02900	      PP1=P1(J)  
03000	      IF(BT.GE.DUR(J))GO TO 5174    
03100		IF(IQ(J).EQ.0)GO TO 200
03200		P2=-IQ(J)/10000.
03300		IQ(J)=0
03400		KNT(J)=-1
03500		ICT=-1
03600	C  PRINTS REST AND KNT=-1 WHEN 1ST BG TIME IS >0
03700		GO TO 4203
03800	
03900	C   IREST IS FLAG FOR RESTS
04000	200	IREST=0
04100	
04200	203	DF=1.
04300	C   DF=DUTY FACTOR 
04400		DO 2155 L=2,NPA
04500		ISUB=0
04600	C  WHY DOES ISUB APPEAR AT 14700/5?
04700		IDF=0 
04800	C    IDF IS DUTY FACTOR FLAG
04900		IJ=IPT(J,L)
05000	3024 	IF(IJ)IJ=JPT(-IJ)
05100		IF(IJ)GO TO 3024 
05200	C  FOLLOWS UP ON POINTERS TO POINTERS!
05300		PM=1.
05400		IF(IJ.GT.1)GO TO 2157
05500		P(L)=0
05600		GO TO 3207 
05700	2157	LN=IJ+2
05800		NM=ABS(V(IJ-1))+LN-4
05900		NL=V(IJ)
06000		IF(NL.GT.-100)GO TO 272
06100		IF(NL.GT.-200)GO TO 372
06200		ISUB=-1
06300		NL=NL+200
06400	C FOR SUBROUTINE FLAG
06500	372	IF(NL.GT.-100)GO TO 272
06600		IDF=-1
06700		NL=NL+100
06800	C  DEC.6,72  FINDS DUTY FACTOR PARAM
06900	272	VIJ2=PARAM(V(IJ+1),KN)
07000	C A PARAM NUM CAN APPEAR ANYWHERE A NORMAL NUM IS EXPECTED.
07100		KIJ2=VIJ2
07200		KN=NL/(-11)
07300		IF(KN.EQ.0)GO TO 1100
07400		GO TO (61,62,62,62,65,65,67,68),KN
07500	
07600	1100	IF(KIJ2.EQ.1)GO TO 1200
07700		ML=3
07800	1900	KA=1
07900		VX1=0
08000		DO 1156 K=LN,NM,ML
08100		X=PARAM(V(K),X)
08200	C NOW % NUM MAY BE A PARAM. (E.G. P22 1,2 ETC.) X IS DUMMY ARG.
08300		VX(KA+1)=X+VX(KA)
08400	1156	KA=KA+1
08500		X=RAN(X)
08600	
08700		DO 1157 K=2,21
08800	C LIMIT OF 20 DIFF. %'S OF RAN. SELECTION ON 2 POSSIBLE LINES.
08900		IF(X.GT.VX(K))GO TO 1157
09000		KL=K-1
09100		IF(KN.EQ.7)GO TO 6157
09200		GO TO 1400
09300	1157	CONTINUE
09400	
09500	1400	LN=IJ+3*KL
09600	1462	RA=PARAM(V(LN),K)
09700		IF(RA.EQ.-10000.)GO TO 4174
09800	C   FOR "FINE" IN RLIST
09900		RB=PARAM(V(LN+1),K)
10000	C FUNCTION PARAM CHECKS TO SEE IF WE SHOULD LOOK AT ANOTHER PARAMETER FOR DATA.
10100		PAR=RAND(RA,RB)
10200	1300	IF(NL.EQ.-1)GO TO 1155
10300		PAR=IFIX(PAR)
10400		PM=2.
10500	C  IF 2 THEN PRINTS A4
10600		IF(PAR.GE.199.)IREST=-1
10700		GO TO 1155
10800	1200	PAR=PARAM(V(IJ+2),PAR)
10900	CHECKS IF REFERING TO OTHER PARAM.
11000		GO TO 1300
11100	
11200	C   NEXT IS FOR SUBROUTINE AND QUAD CALLS
11300	61	IF(NL.LT.-12)GO TO 6100
11400	601	IF(AMOD(V(IJ),1.0).EQ.0)GO TO 871
11500	C FOUND  'MICRO'
11600		CALL MICRO
11700		GO TO 3208 
11800	871	X=P2
11900		CALL SUBR
12000	CC 7/74 NOW SET DUR(J) =0 IN SUBR	IF(DF)GO TO 5174
12100	C* OUT--COLGATE  DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
12200		IF(L.EQ.2)GO TO 4203
12300		IF(X.EQ.P2)GO TO 3208 
12400		PP2=P2
12500		PR=P2
12600		GO TO 3208 
12700	C  ABOVE IS FOR P2 CHANGES IN SUBROUTINE
12800	C  TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
12900	C  ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
13000	C  BE SET TO 'REAL TIME'.)
13100	6100	COFF1(J)=PARAM(V(LN),X)
13200	C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
13300		COFF2(J)=PARAM(V(LN+1),X)
13400		GO TO 2155
13500	
13600	C   FOLLOWING IS FOR STRINGS OF VALUES.  
13700	62	KL=NCNT(J,L)+1
13800		IF(KL.GT.KIJ2)KL=1 
13900		IF(NL.EQ.-46)GO TO 677
14000		IF(NL.NE.-36)GO TO 162
14100	C   THIS PART FOR STRINGS OF RAND SELECTION
14200	677	LN=KL+IJ+1
14300		KL=KL+1
14400		IF(KL.GT.KIJ2)KL=1 
14500		NL=NL+45
14600	C   FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1.  FOR NOTES, =9)
14700	162	NCNT(J,L)=KL
14800		IF(NL.GT.-22)GO TO 1462
14900	C   JUMP RAND SELECTION
15000	      PAR=PARAM(V(IJ+KL+1),K)
15100		IF(K.NE.0)GO TO 1155
15200	C JUMP IF REFERING  TO ANOTHER PARAM.  (I.E. K NOT = 0)
15300		IF(KN.NE.3)GO TO 1155
15400		IF(PAR.EQ.-10000.)GO TO 4174
15500		PM=2.
15600		IF(PAR.GT.300.)GO TO 777
15700		IF(PAR.GE.1.)GO TO 877
15800		IF(NL.NE.-33)GO TO 777
15900	C  NEXT FOR CHORD FEATURE
16000		PAR=-PAR 
16100		CCHD=ABS(V(IJ+KL+2))
16200		KL=KL+1
16300		IF(KL.GT.KIJ2)KL=1
16400		NCNT(J,L)=KL
16500		JCHD=IJ
16600		LCHD=L
16700		GO TO 877
16800	777	PM=3.
16900	877	IF(PAR.EQ.199.)IREST=-1
17000	      GO TO 5155  
17100	
17200	65	W=-9900.-V(IJ-3)
17300	C  W=BG TIME OF MOVE.
17400		X=ABS(V(IJ-1))
17500		IF(NL.EQ.-56)GO TO 977
17600		IF(NL.NE.-58)GO TO 771
17700	977	PM=2.
17800	771	Z=(BT-W)/VIJ2
17900	C  Z= % OF WAY THROUGH.
18000		IF(Z.GT.1.)Z=1.
18100		Y=PARAM(V(LN),Y)
18200		IX=3
18300		IF(X.EQ.7)IX=4
18400		W=PARAM(V(IJ+IX),W)
18500		IF(NL.LT.-58)GO TO 3205 
18600		PAR=(W-Y)*Z+Y
18700		IF(X.EQ.7.)GO TO 1600
18800		GO TO 255
18900	C   FOR "MOVX"
19000	C  THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
19100	3205 	PAR=RMOVX(W,Y,Z)
19200	C  SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
19300	C  THIS NEEDS WORK!
19400		IF(X.NE.7.)GO TO 255
19500		W=PARAM(V(IJ+5),W)
19600		Y=PARAM(V(IJ+3),Y)
19700		X=RMOVX(W,Y,Z)
19800		GO TO 3206 
19900	C  NEXT IS FOR MOVING RAND RANGES.
20000	1600	W=PARAM(V(IJ+3),W)
20100	C*********** BACK TO 65 IS NEW.   FEB. 15,71
20200		X=(PARAM(V(IJ+5),X)-W)*Z+W
20300	3206 	PAR=RAND(PAR,X)
20400	255	IF(PAR.GT.-19999.0)GO TO 155
20500		PAR=PARAM(PAR+10000.,Y)
20600	C THIS FOR MOVP  -- THE NUMS. ARE E.G. -19999.12, -19999.129
20700		GO TO 155
20800	
20900	67	LN=IJ+3
21000		NM=LN+KIJ2-1
21100		ML=1
21200		GO TO 1900
21300	
21400	C 7/74  **** NOTE PROBLEMS OF P2 WITH SUBR, TEMPO, TF AND RAND. TF.
21500	C ALSO DF.  THE REAL TIME VALUE PRINTED MAY HAVE GONE THROUGH MANY
21600	C  CHANGES.  HENCE WHEN TRANSFERING THE VALUE TO OTHER PARAMS OR
21700	C  INSTS GREAT CARE MUST BE TAKEN TO BE SURE THE RESULTS ARE CORRECT.
21800	6157	LN=V(LN-1)
21900		DO 1068 K=1,KL
22000	1068	IF(K.LT.KL)LN=LN+V(LN)+1
22100	2068	PM=LN+1
22200		PAR=LN+V(LN)
22300		IF(PM.EQ.2)PAR=IFIX(PAR)
22400		GO TO 5155
22500	
22600	68	KL=NCNT(J,L)
22700		IF(NL.NE.-1000)GO TO 680
22800	
22900		IF(CCHD.GE.0)GO TO 2155
23000		IF(NPA.LT.3)NPA=3
23100	C NPA CAN =2 IN SOME CASES, THEN THE NEW CHORD NOTE WOULDN'T PRINT.
23200		CCHD=0
23300		KL=NCNT(J,LCHD)+1
23400		X=V(JCHD+KL)
23500	CKL	IF(X.GE.0)GO TO 9203
23600		IF(X.GE.0)GO TO 1170
23700		NCNT(J,LCHD)=KL
23800		CCHD=ABS(V(JCHD+KL+1))
23900	CKL	GO TO 9203
24000		GO TO 1170
24100	680	IF(KL.EQ.0)GO TO 774
24200		IF(KL.NE.10000)GO TO 773
24300	774	KL=KIJ2
24400	773	PM=KL+1
24500		PAR=PM+V(KL)-1
24600		KL=PAR+1
24700		IF(V(KL).NE.-10000.)GO TO 6174
24800		KNT(J)=KNT(J)-1
24900		DUR(J)=BT
25000	C  'END' OR 'FINE' IN 'LIT' LIST.
25100	6174	IF(V(KL).EQ.999.)KL=IJ+2
25200		NCNT(J,L)=KL
25300		GO TO 5155
25400	
25500	155	IF(PM.EQ.2)PAR=IFIX(PAR)
25600	C GETS RID OF UNWANTED DECIMALS
25700	1155	IF(PAR.EQ.-10000.)GO TO 4174
25800	C  TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
25900	5155	P(L)=PAR
26000	3207 	PL(L)=PM
26100		IF(ISUB)GO TO 601
26200		IF(L.EQ.2)GO TO 4203
26300	3208 	IF(IDF.GE.0)GO TO 2155
26400		DF=PAR
26500	C DUTY FAC. IS ALWAYS % OF P2 - WHETHER CONSIDERING BASIC OR REAL TIME.
26600		IDF=0
26700	2155	CONTINUE
26800		GO TO 1170
26900	
27000	4203	X=COFF1(J)
27100		IF(X.EQ.0)GO TO 6102
27200		IF(X.LT.0)GO TO 1102
27300		IF(X.LE.BT)GO TO 6102
27400	C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
27500	C JUMP IF 'TEMPO' CHANGE
27600	1102	IF(BT+X.LT.0)GO TO 6102
27700		Y=COFF2(J)
27800		IF(BT.GE.Y)GO TO 6102
27900	C -N1,N2 CAUSES REST FROM AFTER N1 UP TO N2.
28000		P2=BT-Y
28100	C IF COFF2 IS NEG. THEN WE GET A REST UP TO THAT BASIC TIME. 
28200		GO TO 6102
28300	102	IF(BT+P2.GT.X-COFF2(J))P2=X-BT
28400	6102      PR=P2 
28500		PX2=P2
28600	C TO SAVE THE UNPROCESSED P2 FOR 'P2 P2;' IN INPUT. 7/74
28700	      IF(T5.EQ.0)GO TO 7203   
28800		IF(IT3.LE.1)GO TO 6203
28900		IF(BT.LT.TBG+TDUR)GO TO 6203
29000	3155	IT3=IT3+3
29100		TBG=TBG+TDUR
29200		TDUR=V(IT3)
29300		IF(BT.GE.TBG+TDUR)GO TO 3155
29400		T1=V(IT3+1)
29500		T2=V(IT3+2)
29600		CALL SQYY(AC,T1,T2,TDUR)
29700	6203	RA=PR 
29800		IF(BT.EQ.TBG)XT(J)=T1
29900		K=IT3
30000		RC=0  
30100		KA=1  
30200		Z=TDUR+TBG-BT	
30300		X=T1  
30400		Y=T2  
30500		YY=AC
30600		CHN=TBG	
30700		ZZ=TDUR	
30800	      CALL ACCEL
30900	8203	P2=RA*RD    
31000	7203	P2=P2*T4
31100		X=ABS(P2*TF)
31200	C  P2 IS KEPT WITHOUT TF*
31300		K=X+.5
31400		Y=ROFF(J)
31500		Y=Y+K-X
31600		IF(ABS(Y).LT.1.)GO TO 7155
31700		X=1
31800		IF(Y)X=-X
31900		K=K-X
32000		Y=Y-X 
32100	
32200	C  ROUND-OFF GAP WILL NOT EXCEED .001****.01 WITH NEW DAC!X?#@(MUS10)
32300	C*********** FEB 17,71
32400	7155	IF(P2.NE.0)GO TO 4171
32500		WRITE(NDEV,4171)RINST(J),P1(J)
32600		IREST=-1
32700	4171	FORMAT(/' ******** WARNING: P2 = 0 ******* ',A4,F)
32800		IF(P2)K=-K
32900		PP2=K/RNDOFF
33000		ROFF(J)=Y
33100	C   AVOIDS ROUND-OFF PROBLEMS **** TO 1/100 (1/76)
33200	C AFTER ALL THIS P2 IN SUBR MAY NOT EQUAL PP2(REAL TIME) DF COMES LATER!
33300	
33400		
33500	C   NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
33600	
33700	CKL6155	IF(ICT)GO TO 9203
33800	6155	IF(ICT)GO TO 1170
33900		GO TO 2155
34000	
34100	1170  IF(BT.NE.0)GO TO 577
34200		IF(J.EQ.1)GO TO 303
34300	577	IF(IPT(J,1).EQ.0)GO TO 303    
34400	C NEXT FOR 'RR' = RANDOM RESTS
34500	     	X=ALL(JPT,IPT(J,1))
34600		Y=RAN(Y)
34700	C ABOVE IS SAME AS RAND(0.0, 1.0)
34800		IF(Y-X)IREST=-1
34900	303	IF(IPT(J,NUMPX).EQ.0)GO TO 2303
35000	C 'RD' = RANDOM DEVIATION.  THIS BECOMES P31. IT CAN READ ANOTHER P NUM.
35100	C NUMPX=NUMB. OF PARAMS +1
35200		IF(ICT)GO TO 2303
35300	     	X=ALL(JPT,IPT(J,NUMPX))/2.
35400		IF(PP2.GE.0)GO TO 615
35500		IREST=-1
35600		PP2=-PP2
35700	615	Y=IFIX(RAND(-X,X)*RNDOFF+.5)/RNDOFF
35800	C ROUNDS TO 1/100 OR 1/1000 -- RNDOFF
35900		W=RDEV(J)
36000		IF(ABS(W+Y).GT.X)Y=-Y
36100	C  TOTAL RAND DEV.(RDEV) WON'T EXCEED P100
36200		RDEV(J)=W+Y
36300		PP2=PP2+Y
36400	C  SET P100 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
36500	
36600	2303      IF(IREST)GO TO 2022
36700		IF(PP2)GO TO 2022   
36800	
36900		ZPAR=PP1
37000		P1(J)=PP1+PP2
37100	C   ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
37200		RIN=RINST(J)
37300	2021	IF(PP1.LT.OP1)GO TO 2612
37400		IF(INVIS(J).LT.0)GO TO 2170
37500	C  ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
37600		IF(INONLY.GT.0)GO TO 1204
37700	4021	IF(P(NPA).NE.COPY(NPA))GO TO 5021
37800		IF(PL(NPA).NE.COPYL(NPA))GO TO 5021
37900		IF(PL(NPA).GT.2)GO TO 5021
38000	C  'LIT' DATA WILL ALWAYS PRINT BUT NOT NOTES OR FUNCS.
38100		NPA=NPA-1
38200		IF(NPA.GT.2)GO TO 4021
38300	5021	DO 1304 K=3,NPA
38400		COPYL(K)=PL(K)
38500	1304	COPY(K)=P(K)
38600	1204	IF(PL4.NE.1)GO TO 2170
38700		P4=P4*AMPFAC
38800		W=0
38900		RNP(J)=P4
39000		DO 1021	K=1,NINS
39100	1021	IF(P1(K).GT.PP1)W=W+RNP(K)
39200		IF(W-RAMP.LE.0)GO TO 2170
39300		RAMP=W
39400		AMPTIM=PP1
39500	2170	IF(MX.EQ.3)GO TO 2612
39600	      PP1=PP1-OP1     
39700	C   PUTS SPACES BETWEEN NOTES .GT. .05( APART
39800		IF(MZ.NE.-1)GO TO 5170
39900		IF(A.GE.PP1)GO TO 5170
40000		IF(INONLY)WRITE(JOUT,902)
40100		A=PP1+.05
40200	5170	ML=NPRLN
40300		IF(NPA.LT.NPRLN)ML=NPA
40400		MLX=3
40500		NL=2
40600		IEND=0
40700		K=INVIS(J)
40800		IF(K.EQ.0)GO TO 3170
40900		IF(K.EQ.-1)GO TO 9170
41000		IEND=-1
41100	C THIS DELETES END PRINTOUT ( ;PRINT P1  ETC.)
41200		IF(K.EQ.-2)GO TO 3170
41300	C -1=INVIS FRONT, -2=INVIS END  -3=BOTH
41400	9170	RIN=0
41500	C  NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
41600	C  NEXT CREATES FORMAT DATA IN IFM ARRAY.
41700	3029 	KL=3
41800		GO TO 4170
41900	3170	IF(J.EQ.INONLY)GO TO 775
42000		IF(.NOT.INONLY)GO TO 2612
42100	775	VX(1)=PP1
42200	 	IF(IPT(J,NUMPY).EQ.0)GO TO 1303
42300	C NUMPY=NUMP+2
42400	     	DF=ALL(JPT,IPT(J,NUMPY))
42500	C FOR 'DF'=DUTY FACTOR.  A SINGLE NUM. OR READ A PARAM. (NO TEMPO AFFECT.)
42600	1303	IF(DF.GT.0)GO TO 6170
42700		VX2=PP2+DF
42800		IF(VX2.LE.0)VX2=PP2/2
42900	C NO NEG. TIME VALUES ALLOWED.
43000	C NEG. DF= FIXED REST AREA BEFORE NEXT ATTACK.
43100		GO TO 7170
43200	6170	IF(DF.LT.100)GO TO 8170
43300	C DF+100=FIXED NOTE DUR. NOT.GT.PP2   7/74 COLGATE  -AND BELOW
43400	C DF+1000=FIXED TIME OF OVERLAP  3/77  (CHNG THIS TO 300 SOMEDAY!)
43500		IF(DF.GT.1000)GO TO 8171
43600		VX2=DF-100.
43700		IF(VX2.GT.PP2)VX2=PP2
43800	C DF+200= FIXED DURATION WITHOUT REGARD TO OVERLAPS
43900		IF(DF.GT.200)VX2=DF-200.
44000		GO TO 7170
44100	C*** NEXT FOR DF>1000 ****!!!! SWITCH THIS FEATURE WITH ORD. DF SOMEDAY!!!!
44200	8171	VX2=PP2+DF-1000.
44300		GO TO 7170
44400	8170	VX2=PP2*DF
44500	7170	FRM3=B2A
44600		FRM4=B2B
44700		KL=5
44800		IF(NPA.LT.3)GO TO 2121
44900	
45000	4170	NL=2
45100		DO 1121 K=MLX,ML
45200		X=P(K)
45300		L=PL(K)
45400		IF(L-2)321,521,621
45500	C  L=1 NUMBS,  =2 NOTES,FUNCS,  =3 LITS.
45600	321	IF(X.GE.0)GO TO 4211
45700		FRM(KL)=COMMA
45800		NL=NL+1
45900		KL=KL+1
46000	4211	FRM(KL)=B8
46100		IF(ABS(X).GE.1000.0)FRM(KL)=B9
46200		FRM(KL+1)=BCOM
46300		KL=KL+1
46400		NL=NL+1
46500	421	VX(KL-NL)=X
46600		GO TO 1121
46700	521	LN=X
46800		IF(LN.LT.200)GO TO 2621
46900		LN=LN-200
47000		IF(LN.LT.10)IVX=IF0+LN*2
47100		IF(LN.GE.10)IVX=IF10 + 256*(LN/10) + 2*MOD(LN,10)
47200	C FOR FUNC NUMS. CAN NOW BE F0→F99.  (RVX AND RVX ARE EQUIV.)
47300		GO TO 1621
47400	2621	KA=LN-1
47500		IOCT=1+KA/12
47600		LN=MOD(KA,12)+1
47700		IVX=ISC(LN)+IOC(IOCT)
47800	1621	VX(KL-NL)=RVX
47900		GO TO 42
48000	621	IF(L.GT.3)GO TO 721
48100		VX(KL-NL)=X
48200	C ABOVE LETS A4 WD BE USED IN SUBR BY SETTING IPL(N)=3.
48300	42	FRM(KL)=BA4
48400		KL=KL+1
48500		NL=NL+1
48600		FRM(KL)=BCOM
48700	C   CREATES '1XA4,'
48800		GO TO 1121
48900	721	LN=X
49000		FRM(KL)=B1X
49100		NL=NL+1
49200		DO 821 M=1,LN-L+1
49300	C FOR 'LIT' STRINGS
49400		KL=KL+1
49500		VX(KL-NL)=V(L-1+M)
49600	821	FRM(KL)=BA1
49700	1121	KL=KL+1
49800	
49900	C  NO MORE THAN 80 ITEMS IN FORMAT.
50000	2121	IF(KL.LE.80)GO TO 21211
50100	21212	FORMAT(' ERROR! TOO MANY LIT. ITEMS')
50200		WRITE(NDEV,21212)
50300	21211	DO 921 M=KL+1,80
50400	921 	FRM(M)=BLA
50500		FRM(KL)=BPRN
50600	
50700	1921	L=KL-NL-1
50800		IF(MX)WRITE(MDEV,FRM)RIN,(VX(K),K=1,L)
50900		IF(MZ.GE.0)GO TO 3023 
51000		IF(ML.GE.NPA)FRM(KL)=BDOL
51100		WRITE(JOUT,FRM),RIN,(VX(K),K=1,L)
51200	3023 	IF(ML.GE.NPA)GO TO 3021
51300		MLX=ML+1
51400		ML=ML+NPRLN
51500		IF(ML.GT.NPA)ML=NPA
51600		RIN=BLA
51700	  	GO TO 3029 
51800	3021	IF(IEND)GO TO 3011
51900	C IEND=-1 FOR INVIS. ENDING.  (ALLOWS EXTENTION OF P LIST.)
52000		IF(MX)WRITE(MDEV,3616)RINST(J),ICT
52100	3011	IF(MZ)WRITE(JOUT,8902),J,RINST(J),ICT,BT
52200	2612      PP1=ZPAR     
52300	         GO TO 21 
52400	8902	FORMAT('+;<'I2,1XA4,I4,' >',F7.2)
52500	3616	FORMAT(';  < ',A4,I4)
52600	CC3616	FORMAT(';PRINT P1;< ',A4,I4)
52700	C   PRINTS RESTS  
52800	2022	PP2=ABS(PP2)
52900	C   IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2. 
53000	C   FOR RESTS IN SEQS. TYPE -DUR.   
53100	C   WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
53200	C    RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
53300		RNP(J)=0
53400		P1(J)=PP1+PP2
53500	C   STORES NEXT P1 TIME FOR THIS INST.
53600		IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21   
53700	      X=PP1-OP1  
53800		IF(A.GE.X)GO TO 121
53900		WRITE(JOUT,902)
54000		A=X+.05
54100	C  NEXT PRINTS A REST INDICATION
54200	121	IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),RINST(J),X,PP2,
54300		1 J,RINST(J),ICT,BT
54400	21	IF(CCHD.EQ.0)GO TO 122
54500	C NEXT FOR CHORDS
54600		P3=CCHD
54700		L=LCHD
54800		NL=-1000
54900		CCHD=-CCHD
55000		IJ=JCHD
55100		GO TO 68
55200	4174	KNT(J)=KNT(J)-1
55300	C TO GET PROPER NOTE COUNT AFTER 'FINE' WAS FOUND.
55400		GO TO 5174
55500	122	PR=ABS(PR)
55600		BG(J)=BT+PR 
55700		IF(ICT.EQ.DUR(J)-10000.)GO TO 5174 
55800		IF(BG(J).LT.DUR(J))GO TO 500  
55900	5174	BG(J)=19999. 
56000		DO 3174 K=1,NINS  
56100	C   INSERTS CAN'T FOLLOW LAST REGULAR NOTE.
56200	C   (ADD REST IF INSERT AT END IS NEEDED.)    
56300	3174	IF(BG(K).LT.19999.)GO TO 500     
56400		GO TO 175   
56500	C   CHOOSES INST WITH NEXT BEGIN TIME.    
56600	500	J=1   
56700		BW=BT
56800		NL=NINS
56900		DO 22 K=2,NL
57000	22      IF(BG(J).GT.BG(K))J=K 
57100		IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
57200		J=1
57300		DO 5022 K=2,NINS
57400		X=P1(J)
57500		Y=P1(K)+.0001
57600	C  LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
57700		IF(BG(J).EQ.19999.)X=19999.
57800		IF(BG(K).EQ.19999.)Y=19999.
57900	5022	IF(X.GT.Y)J=K
58000	C   ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
58100	3022      BT=BG(J)    
58200	      IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
58300		IF(KNT(J).GT.0)GO TO 1022
58400	      IF(KNT(J).EQ.0)P1(J)=0  
58500	      IF(KNT(J).EQ.-1)KNT(J)=0
58600	C   N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0   
58700	1022      IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108    
58800	      T4=T2 
58900	      T5=0  
59000	      T6=10000.   
59100	      GO TO 1108    
59200	1175	FORMAT('+',A4,'=',F7.2,'"',I4,' NTS.',4X,$)
59300	C*1175	FORMAT('+',A5,'=',F7.2,3X,$)
59400	1109	FORMAT(' FINISH; < ',A4,'.DAT'/)
59500	1110	FORMAT(' <',A4,2F8.2,2X,'******* REST <'I2,1XA4,I4,F11.2)
59600	1603  FORMAT(' AMPL. FACTOR=',F5.2,',  P4 MAX.AMP.=',F9.2,',  AT TIME='
59700		1,F8.3)
59800	175	IF(MZ)WRITE(JOUT,1109),FNAME
59900		IF(MX.GE.0)GO TO 4175
60000		WRITE(MDEV,1109),FNAME
60100	CC	END FILE 1 
60200		WRITE(NDEV,604  )
60300	604  	FORMAT(/' ***** DATA HAS BEEN WRITTEN ON DISK *****'/)
60400	603	FORMAT(' TOTAL DURS:  ',$)
60500	4175	WRITE(JOUT,1603),AMPFAC,RAMP,AMPTIM
60600		WRITE(JOUT,603)
60700	
60800	5175	IJ=0
60900		Y=0
61000		DO 2175 K=1,NINS
61100		X=P1(K)-OP1
61200		IF(X.GT.Y)Y=X
61300		J=KNT(K)
61400		IJ=IJ+J
61500	6175	WRITE(JOUT,1175),RINST(K),X,J
61600	2175	CONTINUE
61700		IF(NINS.GT.1)WRITE(JOUT,8175)IJ,Y
61800	
61900	8175	FORMAT(/' TOTAL NOTES =',I5,F8.2,'"')
62000	
62100	3175	WRITE(NDEV,1023)FNAME,IXIN
62200		CALL EXIT
62300		END